home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 7 / FM Towns Free Software Collection 7.iso / t_os / tensita / 32kedit5.bas next >
BASIC Source File  |  1993-11-30  |  49KB  |  693 lines
  1. 10 ' Ｇ３２ＫＥＤＩＴ　Ｖｅｒ　５．００　　１９９２年１２月１５日
  2. 20 ' 天使たちの筆　１９９３年 ７月 ８日（改名）
  3. 30 CLEAR ,,,,,300000:DEFINT A-Z:SCREEN 1,1,2,1:SCREEN @1:MOUSE 0,1:CLS:VR$="５．６２Ｂ":V2$="１９９３年８月２０日":OP=13:S12$="システム12ﾄﾞｯﾄ":S16$="システム16ﾄﾞｯﾄ":DEF FONT S16$
  4. 40 DIM CO(2,2),WX(9),WY(9),W2X(9),W2Y(9),WC(9),PIC(76800),OP(OP),CX(99),CY(99),EM$(7,20):FOR A=0 TO 2:CO(0,A)=248:NEXT
  5. 50 DIM IC1(79),IC2(63),IC3(127),IC4(319),IC5(256),MPIC(1024),MPI1(64),MPIC2(1024),MPI2(64),COC(9,2),RX(15),RY(15)
  6. 60 FOR A=0 TO 9:READ COC(A,0),COC(A,1),COC(A,2):NEXT:FOR A=0 TO OP:READ OP(A):NEXT:SI=OP(0)
  7. 70 DEF FNSIZ!(CCX,CCY)=INT((2*(CCX+1)*(CCY+1)+1)/2):DEF FNR(RX)=-(RX>0 AND RX<97)*RX-(RX>96)*96:CC=-1:GOSUB 430
  8. 80 CLS:SCREEN 1,1,2,1:IF OP(12)=0 THEN 120
  9. 90 ON ERROR GOTO *TIER:LOAD@"TITLE.TIF":ON ERROR GOTO 0:GOTO 170
  10. 100 *TIER
  11. 110 RESUME 120
  12. 120 SCREEN @0:PALETTE:LP=16:LP2=6:PE=0:LPC2=1:LPC3=0:CDC=0:PALETTE 13,[208,208,208]:COC=1:DEF FONT S16$
  13. 130 LINE(100,100)-(540,380),PSET,7,BF:CIRCLE(320,240),110,%13,,,,F:CIRCLE(320,240),100,7,,,,F:LINE(260,180)-(270,300),PSET,%13,BF:LINE(370,180)-(380,300),PSET,%13,BF
  14. 140 LINE(315,240)-(325,300),PSET,%13,BF:LINE(260,185)-(315,240),PSET,%13:LINE(270,180)-(320,230),PSET,%13:LINE(325,240)-(380,185),PSET,%13:LINE(320,230)-(370,180),PSET,%13:PAINT@(320,235),%13
  15. 150 SYMBOL(150,120),"天使たちの筆",2,2,%14,,,15,6:SYMBOL(180,160),"Ｖｅｒ　"+VR$,2,2,7,,,15:SYMBOL(120,200),"制作期間",2,2,%14,,,15,4:SYMBOL(130,240),"１９９２年１２月１５日－",2,2,7,,,15
  16. 160 SYMBOL(200,280),V2$,2,2,7,,,15:SYMBOL(150,325),"制作 元内 康博",2,2,%14,,,15,4:CC=MOUSE(2,0)+MOUSE(2,1)
  17. 170 IF FRE(3)>260000 THEN DIM PICBAK(122880):PICBAK=1:LINE(200,385)-(420,411),PSET,6,B:A$="ＵＮＤＯ機能が使用できます":IF OP(12)=1 THEN SYMBOL(50,220),A$,1,1,6 ELSE SYMBOL(205,390),A$,1,1,6:WAIT 99
  18. 180 MJC=0:BI!=1:IF CC<0 OR INKEY$<>"" THEN 200
  19. 190 DEF FONT S12$:MJC=1:BI!=.75!
  20. 200 IF OP(12)=0 THEN FOR A=0 TO 220:LINE(100+A,100+A)-(540-A,415-A),PSET,0,B:NEXT:SCREEN 1,0 ELSE WAIT 200
  21. 210 SCREEN @1:WINDOW(0,0)-(511,255):VIEW(0,0)-(511,255):MOUSE 1,120,160,1:MOUSE 4,0,0,-511*(OP(8)=1)-319*(OP(8)=0),255:SCREEN 1,1,0:SCREEN @1:WINDOW(0,0)-(511,255):VIEW(0,0)-(511,255):SYMBOL(0,0),"A",1,1,7
  22. 220 C3=PEEK([&H1C]270336):B=INT(C3 AND 31)*8:IF B=0 THEN MJC=0:BI!=1
  23. 230 IF FRE(4)<56000 AND PICBAK=0 THEN JP=1 ELSE JP=0
  24. 240 FOR A=0 TO 6:FOR B=0 TO 20
  25. 250 READ A$:IF A$="*" THEN B=21:NEXT:GOTO 270
  26. 260 EM$(A,B)=A$:NEXT
  27. 270 NEXT:CC=-1:C2=0
  28. 280 FOR A=2 TO 15:READ RX(A),RY(A):NEXT
  29. 290 LINE(0,0)-(511,255),PSET,[0,0,0,1],BF:SCREEN 1,0,3:PASTEL OP(1):GOSUB *W1:GOTO *MAIN
  30. 300 *R1
  31. 310 DATA 0,0,0 ,248,248,248 ,128,128,128 ,248,0,0 ,0,248,0 ,0,0,248 ,128,0,0 ,0,128,0 ,0,0,128,248,0,248
  32. 320 *R2
  33. 330 DATA 16,128,0,0,0,0,16,15,1,2,1,1,0,0
  34. 340 DATA １６ドット,３２ドット,６４ドット,９６ドット,２倍拡大,３倍拡大,６倍拡大,１２倍拡大,点を描く,ラインのＯＦＦ,色を混ぜる,色を調べる,ラインモード変更,右ｸﾘｯｸで調べる,*
  35. 350 DATA *
  36. 360 DATA TIF形式ＬＯＡＤ,TIF形式ＳＡＶＥ,LZH圧縮ＳＡＶＥ,JPEG形式ＳＡＶＥ,JPEG形式ＬＯＡＤ,*
  37. 370 DATA 新規作成,ＣＤ(PLAY STOP),オプション,アニメーション,*
  38. 380 DATA 複写,特殊複写,同色塗り潰し,範囲塗り潰し,四角を描く,円を描く,塗り潰し円を描く,絵の反転,特別処理,色の入替え,文字を出力,明暗変換,霧吹き,透明塗り潰し,スプライト化
  39. 390 DATA ペン書き,グラデーション,回転,線書き,ＵＮＤＯ,*
  40. 400 DATA *
  41. 410 DATA アイコン表示,*
  42. 420 DATA 53,80,80,120,96,144,107,160,114,171,120,180,125,187,128,192,131,196,133,200,135,203,137,206,139,208,140,210
  43. 430 *ｱｲｺﾝ登録
  44. 440 DEF FONT S12$:SCREEN 1,1,1:WINDOW(0,0)-(511,255):VIEW(0,0)-(511,255):CX=0:CY=0:IC1(0)=-1:IC1(15)=-1:IF C2=1 THEN SHELL CHR$(65+CC)+":":C3=0
  45. 450 ON ERROR GOTO *ERIC:LOAD@"ICON.TIF":C2=1:OPEN "I",#1,"32KEDIT5.DAT"
  46. 460 INPUT #1,A$,CC:IF A$<>"天使達の筆 Ｖｅｒ ５.００" THEN CLOSE #1:GOTO 480
  47. 470 FOR A=0 TO CC:INPUT #1,OP(A):NEXT:FOR A=0 TO 9:INPUT #1,COC(A,0),COC(A,1),COC(A,2):NEXT:CLOSE #1
  48. 480 ON ERROR GOTO 0
  49. 490 GET@A(320,16)-(335,31),MPIC2:PUT@A(320,32)-(335,47),MPIC2:LINE(320,16)-(335,31),PSET,0,BF:GET@A(320,0)-(351,31),MPIC:GET@(320,0)-(351,31),MPI1,0:GET@A(320,32)-(351,63),MPIC2:GET@(320,32)-(351,63),MPI2,0
  50. 500 GET@(0,0)-(79,15),IC1,0:GET@(128,0)-(191,15),IC2,0:GET@(192,0)-(319,15),IC3,0:GET@(160,16)-(319,31),IC4,0:LINE(0,32)-(159,47),PSET,7,BF:PUT@(0,32)-(159,47),IC4,,0:GET@(0,16)-(159,47),IC4,0
  51. 510 LINE(0,0)-(119,23),PSET,7,BF:FOR A=0 TO 1:FOR B=0 TO 3:LINE(B*16,A*16)-(B*16+15,A*16+15),PSET,7,B:NEXT:NEXT:SYMBOL(1,1),"16326496",.75!,.75!,0:SYMBOL(4,13),"2 3 612",.75!,.75!,0:SYMBOL(84,1),"点",.75!,.75!,0:SYMBOL(84,13),"調",.75!,.75!,0
  52. 520 SYMBOL(60,0),"↑",.75!,.75!,0:SYMBOL(48,6),"←",.75!,.75!,0:SYMBOL(72,6),"→",.75!,.75!,0:SYMBOL(60,12),"↓",.75!,.75!,0:SYMBOL(96,0),"NO混",.75!,.75!,0:SYMBOL(96,12),"Ｌｼﾗ",.75!,.75!,0:GET@(0,0)-(119,23),IC5,0:RETURN
  53. 530 *ERIC
  54. 540 CC=CC+1:C2=1
  55. 550 IF CC=18 THEN
  56. 560 IF C3=0 THEN OP(11)=0:SE$="ICON.TIFが存在しないか読み込めません":GOSUB *YN
  57. 570 IF C3=1 THEN RESUME 480
  58. 580 ENDIF
  59. 590 RESUME 440
  60. 600 END
  61. 610 *G1
  62. 620 FOR G=8 TO 0 STEP -1:WC(G+1)=WC(G):WX(G+1)=WX(G):WY(G+1)=WY(G):W2X(G+1)=W2X(G):W2Y(G+1)=W2Y(G):NEXT
  63. 630 FOR G=0 TO 8:IF WC(G)=CC THEN FOR G1=G TO 8:WC(G1)=WC(G1+1):WX(G1)=WX(G1+1):WY(G1)=WY(G1+1):W2X(G1)=W2X(G1+1):W2Y(G1)=W2Y(G1+1):NEXT:WC(G1)=0
  64. 640 NEXT:IF WC(G)=CC THEN WC(GG)=0
  65. 650 WC(0)=CC:WC=0:RETURN
  66. 660 *W1
  67. 670 IF MJC=1 THEN DEF FONT S12$
  68. 680 MOUSE 1,,,0:SCREEN 1,1,3:LINE(0,0)-(511,255),PSET,[0,0,0,1],BF:LINE(0,0)-(207,15),PSET,7,BF:LINE(1,1)-(79,15),PSET,[96,96,96],BF:SYMBOL(1,1),"天使たちの筆",.75!,BI!,0
  69. 690 WINDOW(0,0)-(511,239):VIEW(0,0)-(511,239):PUT@(80,0)-(207,15),IC3,,0
  70. 700 IF ICWI=1 THEN LINE(208,0)-(349,15),PSET,[96,96,96],BF,7
  71. 710 *表示
  72. 720 IF C1X<177 AND C1Y<16 ELSE LINE(C1X,C1Y)-(C1X+LP-1,C1Y+LP-1),PSET,[208,208,208],B,&H5555
  73. 730 FOR G=9 TO 0 STEP -1:IF WC(G)>0 THEN WC=G:ON WC(G) GOSUB *E1,*E2,*E3,*E4,*E5,*E6
  74. 740 NEXT:MOUSE 1,,,1:RETURN
  75. 750 *コメント
  76. 760 CX=MOUSE(0):CY=MOUSE(1):OUT &H440,21:OUT &H442,0
  77. 770 CRX=53+OP(9):CRX=RX(OP(9))-(OP(8)=1)*97:CRY=RY(OP(9)):RX=INT(CX-160/OP(9))/2:RY=INT(CY-120/OP(9)):RX=(OP(8)=1)*(RX>CRX-1)*CRX+RX*(RX>0 AND RX<CRX)*(OP(8)=1)+(OP(8)=0 AND OP(9)>1)*(RX>0 AND RX<CRX)*RX+(OP(8)=0 AND OP(9)>1)*(RX>CRX-1)*CRX
  78. 780 RY=-(RY>0 AND RY<CRY)*RY-(RY>CRY-1)*CRY:OUT &H440,17:OUT &H442,RX:OUT &H443,RY
  79. 790 RETURN
  80. 800 *コメ
  81. 810 SCREEN 1,1:LINE(0,0)-(511,239),PSET,[0,0,0,1],BF:SYMBOL(0,0),SE$,BI!,BI!,[128,128,128]:SE$="":SCREEN 1,0:CX=MOUSE(0):CY=MOUSE(1):MOUSE 0,0:MOUSE 1,CX,CY,1:MOUSE 4,0,0,-511*(OP(8)=1)-319*(OP(8)=0),239:IX=CX:IY=CY
  82. 820 GOSUB *形状:OUT &H440,27:OUT &H442,OP(9)+(OP(9))*16:RETURN
  83. 830 *E1
  84. 840 QC=LP*LP2:IF WY(WC)+W2Y(WC)>239 THEN WY(WC)=16
  85. 850 CX=WX(WC):CY=WY(WC):LINE(CX,CY)-(CX+QC+2,CY+QC+14),PSET,[96,96,96],BF,7:IF KN=0 THEN SYMBOL(CX+14,CY+1),"ルーペ",.75!,.75!,0
  86. 860 LINE(CX+1,CY+1)-(CX+11,CY+11),PSET,[96,96,96],BF:LINE(CX+1,CY+1)-(CX+11,CY+11),PSET,0:SCREEN 1,0:GET@A(C1X,C1Y)-(C1X+LP-1,C1Y+LP-1),PIC:SCREEN 1,1:PUT@A(CX+1,CY+13)-(CX+LP,CY+12+LP),PIC,,LP2,LP2
  87. 870 LINE(CX,CY+13+QC)-(CX+119,CY+37+QC),PSET,[96,96,96],BF,7:LINE(CX+INT(LP/30)*12,CY+13+QC)-(CX+INT(LP/30)*12+11,CY+24+QC),PSET,[176,0,0],BF
  88. 880 IF PE<2 THEN LINE(CX+84,CY+14+QC+PE*12)-(CX+94,CY+25+QC+PE*12),PSET,[PE*255,255,0],BF ELSE IF PE=2 THEN LINE(CX+108,CY+14+QC)-(CX+119,CY+25+QC),PSET,[0,255,0],BF
  89. 890 LINE(CX+INT(LP2/3.5!+.3!)*12,CY+25+QC)-(CX+INT(LP2/3.5!+.3!)*12+11,CY+36+QC),PSET,[0,0,255],BF:PUT@(CX,CY+13+QC)-(CX+119,CY+36+QC),IC5,,0
  90. 900 IF LPC3=1 THEN LINE(CX+108,CY+QC+25)-(CX+119,CY+QC+36),XOR,7,BF
  91. 910 IF LPC=1 THEN
  92. 920 IF LPC2=1 THEN
  93. 930 FOR A=LP2 TO QC-LP2 STEP LP2:LINE(CX+A,CY+13)-(CX+A,CY+12+QC),PSET,[0,0,96]:LINE(CX+1,CY+A+13)-(CX+QC,CY+A+13),PSET,[0,0,96]:NEXT
  94. 940 ENDIF
  95. 950 FOR A=8*LP2 TO (LP-8)*LP2 STEP 8*LP2:LINE(CX+A,CY+13)-(CX+A,CY+12+QC),PSET,7,,&H5555:LINE(CX+1,CY+A+13)-(CX+QC,CY+A+13),PSET,7,,&H5555:NEXT
  96. 960 ENDIF
  97. 970 RETURN
  98. 980 *E2
  99. 990 CX=WX(WC):CY=WY(WC):LINE(CX,CY)-(CX+93,CY+50),PSET,[96,96,96],BF,7:IF KN=0 THEN SYMBOL(CX+14,CY+1),"カラー",.75!,.75!,0
  100. 1000 LINE(CX+1,CY+1)-(CX+11,CY+11),PSET,[96,96,96],BF:LINE(CX+1,CY+1)-(CX+11,CY+11),PSET,0
  101. 1010 FOR A=0 TO 2:LINE(CX+4+A*30,CY+14)-(CX+30+A*30,CY+20),PSET,0,BF,[CO(A,0),CO(A,1),CO(A,2)]:NEXT:FOR A=0 TO 2:LINE(CX+3,CY+22+A*6)-(CX+91,CY+27+A*6),PSET,0,BF,3-A-(A=0):NEXT
  102. 1020 FOR A=0 TO 9:LINE(CX+1+A*9,CY+40)-(CX+11+A*9,CY+49),PSET,0,BF,[COC(A,0),COC(A,1),COC(A,2)]:NEXT:FOR A=0 TO 2:LINE(CX+4+CO(2,A)/3,CY+23+A*6)-(CX+7+CO(2,A)/3,CY+26+A*6),PSET,7,B:NEXT
  103. 1030 LINE(CX+1+COC*9,CY+40)-(CX+10+COC*9,CY+49),PSET,7,B:RETURN
  104. 1040 *E3
  105. 1050 CX=WX(WC):CY=WY(WC):LINE(CX,CY)-(CX+81,CY+28),PSET,[96,96,96],BF,7:IF KN=0 THEN SYMBOL(CX+14,CY+1),"ファイル",.75!,.75!,0
  106. 1060 LINE(CX+1,CY+1)-(CX+11,CY+11),PSET,[96,96,96],BF:LINE(CX+1,CY+1)-(CX+11,CY+11),PSET,0
  107. 1070 PUT@(CX+1,CY+12)-(CX+80,CY+27),IC1,,0:RETURN
  108. 1080 *E4
  109. 1090 CX=WX(WC):CY=WY(WC):LINE(CX,CY)-(CX+65,CY+28),PSET,[96,96,96],BF,7:IF KN=0 THEN SYMBOL(CX+14,CY+1),"その他",.75!,.75!,0
  110. 1100 LINE(CX+1,CY+1)-(CX+11,CY+11),PSET,[96,96,96],BF:LINE(CX+1,CY+1)-(CX+11,CY+11),PSET,0
  111. 1110 PUT@(CX+1,CY+12)-(CX+64,CY+27),IC2,,0:RETURN
  112. 1120 *E5
  113. 1130 CX=WX(WC):CY=WY(WC):LINE(CX,CY)-(CX+159,CY+44),PSET,[96,96,96],BF,7:IF KN=0 THEN SYMBOL(CX+14,CY+1),"編集",.75!,.75!,0
  114. 1140 LINE(CX+1,CY+1)-(CX+11,CY+11),PSET,[96,96,96],BF:LINE(CX+1,CY+1)-(CX+11,CY+11),PSET,0
  115. 1150 PUT@(CX,CY+12)-(CX+159,CY+43),IC4,,0:RETURN
  116. 1160 *E6
  117. 1170 CX=WX(WC):CY=WY(WC):LINE(CX,CY)-(CX+99,CY+49),PSET,[96,96,96],BF,7:SYMBOL(CX+14,CY+1),"残りメモリ",.75!,.75!,0:LINE(CX+1,CY+1)-(CX+11,CY+11),PSET,[96,96,96],BF:LINE(CX+1,CY+1)-(CX+11,CY+11),PSET,0
  118. 1180 SYMBOL(CX+1,CY+13),"ﾃｷｽﾄ"+STR$(FRE(1))+"ﾊﾞｲﾄ",.75!,.75!,0:SYMBOL(CX+1,CY+25),"配列"+STR$(FRE(3))+"ﾊﾞｲﾄ",.75!,.75!,0:SYMBOL(CX+1,CY+37),"合計"+STR$(FRE(4))+"ﾊﾞｲﾄ",.75!,.75!,0:RETURN
  119. 1190 'ファイル
  120. 1200 CC=3:GOSUB *G1:WX(0)=5:WY(0)=20:W2X(0)=80:W2Y(0)=29:GOSUB *E3:GOTO *MAIN
  121. 1210 GOTO *MAIN
  122. 1220 'ルーペ
  123. 1230 WAIT 20:SE$="":GOSUB *コメ:DEF PEN 0,1:LINE(CX,CY)-(CX+LP-1,CY+LP-1),XOR,7,B
  124. 1240 GOSUB *コメント:CX=INT(CX/SI)*SI:CY=INT(CY/SI)*SI:IF IX<>CX OR IY<>CY THEN LINE(IX,IY)-(IX+LP-1,IY+LP-1),XOR,7,B:LINE(CX,CY)-(CX+LP-1,CY+LP-1),XOR,7,B:IX=CX:IY=CY
  125. 1250 IF MOUSE(2,0)=0 THEN 1240
  126. 1260 LINE(CX,CY)-(CX+LP-1,CY+LP-1),XOR,7,B:MOUSE 0,1:MOUSE 0,1:MOUSE 1,CX,CY,1:MOUSE 4,0,0,-511*(OP(8)=1)-319*(OP(8)=0),239
  127. 1270 C1X=CX:C1Y=CY:CC=1:GOSUB *G1:WX(0)=105-RX*(OP(8)=1):WY(0)=90:W2X(0)=LP*LP2+2:W2Y(0)=W2X(0)+35:W2X(0)=-(W2X(0)>119)*W2X(0)-(W2X(0)<120)*120:GOSUB *W1:GOTO *MAIN
  128. 1280 'カラー
  129. 1290 MOUSE 1,,,0:CC=2:GOSUB *G1:WX(0)=5:WY(0)=110:W2X(0)=94:W2Y(0)=50:GOSUB *E2:MOUSE 1,,,1:GOTO *MAIN
  130. 1300 '編集
  131. 1310 CC=5:GOSUB *G1:WX(0)=150:WY(0)=25:W2X(0)=160:W2Y(0)=45:GOSUB *E5:GOTO *MAIN
  132. 1320 'その他
  133. 1330 CC=4:GOSUB *G1:WX(0)=240:WY(0)=150:W2X(0)=64:W2Y(0)=29:GOSUB *E4:GOTO *MAIN
  134. 1340 'ICON
  135. 1350 ICWI=1-ICWI:IF ICWI=1 THEN LINE(208,0)-(349,15),PSET,[96,96,96],BF,7 ELSE LINE(208,0)-(349,15),PSET,[0,0,0,1],BF
  136. 1360 WAIT 9:GOTO *MAIN
  137. 1370 *YN
  138. 1380 SCREEN 1,1,3:CX=MOUSE(0):CY=MOUSE(1):MOUSE 0,1:MOUSE 1,CX,CY,1:DEF FONT S16$:GOSUB *形状
  139. 1390 OUT &H440,17:OUT &H442,0:OUT &H443,0:OUT &H440,21:OUT &H442,0
  140. 1400 LINE(10,99)-(310,139),PSET,0,BF,[128,128,128]:SYMBOL(12,101),SE$,1,1,7:LINE(190,120)-(221,138),PSET,0,B:LINE(230,120)-(261,138),PSET,0,B:SYMBOL(191,121),"実行",1,1,7:SYMBOL(231,121),"取消",1,1,7:MOUSE 4,11,99,309,139
  141. 1410 CX=MOUSE(0)-190:CY=MOUSE(1)-120:IF MOUSE(2,0)=0 THEN 1410
  142. 1420 IF NOT(CX>0 AND CX<68 AND CY>0 AND CY<15) THEN 1410
  143. 1430 MOUSE 4,0,0,-511*(OP(8)=1)-319*(OP(8)=0),255:QC=INT(CX/35):IF MJC=1 THEN DEF FONT S12$
  144. 1440 RETURN
  145. 1450 *形状
  146. 1460 IF OP(11)=1 THEN MOUSE 6,1,MPI1,MPIC
  147. 1470 IF OP(11)=2 THEN MOUSE 6,1,MPI2,MPIC2
  148. 1480 RETURN
  149. 1490 *MAIN
  150. 1500 ON ERROR GOTO *ERG:SCREEN 1,0:DEF PEN 0,OP(10):SCREEN 1,1:CX=MOUSE(0):CY=MOUSE(1):MOUSE 0,1:MOUSE 1,CX,CY,1:MOUSE 4,0,0,-511*(OP(8)=1)-319*(OP(8)=0),239:KN=OP(13):OUT &H440,27:OUT &H442,17:GOSUB *形状
  151. 1510 CX=MOUSE(0):RX=INT(CX/2-80):RX=FNR(RX)*-(OP(8)=1):OUT &H440,17:OUT &H442,RX:OUT &H443,0:CY=MOUSE(1):OUT &H440,21:OUT &H442,RX
  152. 1520 IF MOUSE(2,0)=-1 THEN C1=0 ELSE IF MOUSE(2,1)=-1 THEN C1=1 ELSE C1=2
  153. 1530 IF WC(0)=1 AND WX(0)<CX AND WY(0)+12<CY AND WX(0)+W2X(0)>CX AND WY(0)+W2Y(0)>CY AND C1<>2 THEN CCX=CX-WX(0):CCY=CY-WY(0):GOTO *ルーペ
  154. 1540 '★ICONチェック 
  155. 1550 IF ICWI=1 THEN
  156. 1560 CC=-1:FOR A=0 TO 9:IF WC(A)>0 AND WX(A)<CX AND WY(A)+12<CY AND WX(A)+W2X(A)>CX AND WY(A)+W2Y(A)-2>CY THEN CC=A:A=9
  157. 1570 NEXT:IF CC=-1 THEN ICW3=0:IF ICW1=-1 AND TIME=TIM! THEN 1770 ELSE LINE(208,1)-(348,14),PSET,7,BF:SYMBOL(210,2+(MJC=0)*2),"時刻 "+TIME$,BI!,BI!,[96,96,96]:ICW1=-1:TIM!=TIME:GOTO 1770
  158. 1580 ICW1=-1:ICW2=0
  159. 1590 IF WC(CC)=3 OR WC(CC)=4 THEN ICW1=WC(CC)-1:ICW2=INT((CX-WX(CC))/16)
  160. 1600 IF WC(CC)=5 THEN ICW1=4:ICW2=INT((CX-WX(CC))/16)+INT((CY-WY(CC)-12)/16)*10
  161. 1610 IF WC(CC)=2 THEN
  162. 1620 ICW1=1:ICW2=0:CCX=CX-WX(CC):CCY=CY-WY(CC):EM$(1,ICW2)=""
  163. 1630 IF CCY>14 AND CCY<20 THEN
  164. 1640 IF CCX>4 AND CCX<30 THEN ICW2=1:EM$(1,1)="("+STR$(CO(0,0))+","+STR$(CO(0,1))+","+STR$(CO(0,2))+")"
  165. 1650 IF CCX>34 AND CCX<60 THEN ICW2=2:EM$(1,2)="("+STR$(CO(1,0))+","+STR$(CO(1,1))+","+STR$(CO(1,2))+")"
  166. 1660 IF CCX>64 AND CCX<90 THEN ICW2=3:EM$(1,3)="("+STR$(CO(2,0))+","+STR$(CO(2,1))+","+STR$(CO(2,2))+")"
  167. 1670 ELSE
  168. 1680 ENDIF
  169. 1690 ELSE
  170. 1700 ENDIF
  171. 1710 IF WC(CC)=1 THEN 
  172. 1720 ICW1=0:CCX=CX-WX(CC):CCY=CY-WY(CC):IF CCX<47 AND CCY>LP*LP2+14 THEN ICW2=INT(CCX/12)+INT((CCY-LP*LP2-14)/12)*4
  173. 1730 IF CCX>80 AND CCY>LP*LP2+14 AND CCX<116 THEN ICW2=8+INT((CCX-84)/12)+INT((CCY-LP*LP2-14)/12)*3
  174. 1740 ENDIF
  175. 1750 IF NOT(ICW1=ICW3 AND ICW2=ICW4) AND ICW1>-1 AND ICW2>-1 THEN LINE(208,1)-(348,14),PSET,7,BF:SYMBOL(210,2+(MJC=0)*2),EM$(ICW1,ICW2),BI!,BI!,[96,96,96]:ICW3=ICW1:ICW4=ICW2
  176. 1760 ENDIF
  177. 1770 IF C1=2 THEN 1510
  178. 1780 IF CY<16 THEN
  179. 1790 IF CX<80 THEN CC=6:GOSUB *G1:WX(0)=0:WY(0)=20:W2X(0)=100:W2Y(0)=50:GOSUB *E6:GOTO *MAIN
  180. 1800 IF CX>80 AND CX<207 THEN ON INT((CX-80)/16)+1 GOTO 1200,1220,1280,1310,1330,1350
  181. 1810 IF CX>175 AND CX<192 THEN 
  182. 1820 SCREEN 1,1:LINE(0,0)-(511,255),PSET,[0,0,0,1],BF
  183. 1830 IF MOUSE(2,0)=-1 OR MOUSE(2,1)=-1 THEN 1830
  184. 1840 GOSUB *W1:GOTO *MAIN
  185. 1850 ENDIF
  186. 1860 IF CX>191 AND CX<208 THEN SE$="絵を破棄しＳＹＳＴＥＭに戻ります｡":GOSUB *YN ELSE 1970
  187. 1870 IF QC=0 THEN 
  188. 1880 SCREEN 1,1,2:SCREEN@0:PALETTE 13,[208,208,208]:LINE(0,0)-(639,479),PSET,7,BF:CIRCLE(320,240),110,%13,,,,F:CIRCLE(320,240),100,7,,,,F:LINE(260,180)-(270,300),PSET,%13,BF:LINE(370,180)-(380,300),PSET,%13,BF
  189. 1890 LINE(315,240)-(325,300),PSET,%13,BF:LINE(260,185)-(315,240),PSET,%13:LINE(270,180)-(320,230),PSET,%13:LINE(325,240)-(380,185),PSET,%13:LINE(320,230)-(370,180),PSET,%13:PAINT@(320,235),%13
  190. 1900 DEF FONT S16$:SYMBOL(258,50),"制作 元内 康博",1,1,%13,,,4:WAIT 99
  191. 1910 IF MOUSE(2,0)=-1 OR MOUSE(2,1)=-1 THEN SCREEN@1:GOSUB *W1:GOTO *MAIN 
  192. 1920 FOR A=0 TO 16:FOR B=2 TO 0 STEP -1:LINE(190+A*16,87)-(214+A*16,111),PSET,7,BF:SYMBOL(190+A*16+B*8,95+B*8),KMID$("　又の御使用を、お待ちしております。",A+2+(B=2),1),1,1,%14,B,,4:WAIT 3:NEXT:NEXT:SYSTEM
  193. 1930 ELSE
  194. 1940 GOSUB *W1:GOTO *MAIN
  195. 1950 ENDIF
  196. 1960 ENDIF
  197. 1970 WC=0
  198. 1980 IF NOT(WX(WC)<CX AND WX(WC)+W2X(WC)>CX AND WY(WC)<CY AND WY(WC)+W2Y(WC)>CY) THEN WC=WC+1:IF WC<10 THEN 1980 ELSE WC=0:GOTO *MAIN
  199. 1990 *WINDOW
  200. 2000 WCC=0
  201. 2010 IF WC>0 THEN SWAP WX(WC),WX(0):SWAP WY(WC),WY(0):SWAP W2X(WC),W2X(0):SWAP W2Y(WC),W2Y(0):SWAP WC(WC),WC(0):SWAP WX(WC),WX(1):SWAP WY(WC),WY(1):SWAP W2X(WC),W2X(1):SWAP W2Y(WC),W2Y(1):SWAP WC(WC),WC(1):WC=0:WCC=1
  202. 2020 CCX=CX-WX(WC):CCY=CY-WY(WC)
  203. 2030 IF CCY<13 THEN
  204. 2040 IF CCX<12 THEN 
  205. 2050 IF WC(0)=7 THEN ICWI=0
  206. 2060 FOR G=1 TO 9:WC(G-1)=WC(G):WX(G-1)=WX(G):WY(G-1)=WY(G):W2X(G-1)=W2X(G):W2Y(G-1)=W2Y(G):NEXT
  207. 2070 ELSE
  208. 2080 SCREEN 1,0:DEF PEN 0,1
  209. 2090 CX=MOUSE(0)-CCX:CY=MOUSE(1)-CCY:FOR A=0 TO 1:SCREEN 1,A:LINE(CX,CY)-(CX+W2X(0)-1,CY+W2Y(0)-1),XOR,7,B:NEXT:WAIT 3:FOR A=0 TO 1:SCREEN 1,A:LINE(CX,CY)-(CX+W2X(0)-1,CY+W2Y(0)-1),XOR,7,B:NEXT
  210. 2100 RX=INT(CX/2-80):RX=FNR(RX)*-(OP(8)=1):OUT &H440,17:OUT &H442,RX:OUT &H440,21:OUT &H442,RX
  211. 2110 IF MOUSE(2,C1)=-1 THEN 2080 
  212. 2120 IF CY<17 THEN CY=17 
  213. 2130 WX(0)=CX:WY(0)=CY
  214. 2140 ENDIF
  215. 2150 GOSUB *W1:GOTO *MAIN
  216. 2160 ELSE
  217. 2170 IF WCC=1 THEN MOUSE 1,,,0:ON WC(0) GOSUB *E1,*E2,*E3,*E4,*E5,*E6:MOUSE 1,,,1
  218. 2180 ON WC(0) GOTO *ルーペ,*カラー,*ファイル,*その他,*編集
  219. 2190 GOTO *MAIN
  220. 2200 ENDIF
  221. 2210 *ルーペ
  222. 2220 IF PICBAK=1 THEN SCREEN 1,0:GET@A(0,0)-(511,239),PICBAK:SCREEN 1,1
  223. 2230 IF CCX>1 AND CCY>11 AND CCX<LP*LP2 AND CCY<LP*LP2+12 THEN 
  224. 2240 '★点
  225. 2250 CX=INT((CCX-1)/LP2):CY=INT((CCY-13)/LP2):SCREEN 1,0
  226. 2260 IF PE=0 AND NOT(LPC3=1 AND C1=1) THEN 
  227. 2270 PSET(CX+C1X,CY+C1Y),[CO(C1,0),CO(C1,1),CO(C1,2)]:SCREEN 1,1:LINE(WX(0)+1+CX*LP2,WY(0)+13+CY*LP2)-(WX(0)+CX*LP2+LP2,WY(0)+CY*LP2+LP2+12),PSET,[CO(C1,0),CO(C1,1),CO(C1,2)],BF
  228. 2280 ELSE IF PE=1 OR LPC3=1 THEN
  229. 2290 IF LPC3=1 THEN C1=0
  230. 2300 CC!=(CX+C1X)*2+(CY+C1Y)*1024:C3=PEEK([&H1C]CC!):C2=PEEK([&H1C]CC!+1):CO(C1,2)=(C3 AND 31)*8:CO(C1,0)=((C2 AND 127)-(C2 AND 3))*2:CO(C1,1)=INT(((C2 AND 3)*64+(C3/8)*2)/8)*8
  231. 2310 IF COC2=C1 THEN COC(COC,0)=CO(C1,0):COC(COC,1)=CO(C1,1):COC(COC,2)=CO(C1,2)
  232. 2320 SCREEN 1,1:FOR A=0 TO 9:IF WC(A)=2 THEN LINE(WX(A)+4+C1*30,WY(A)+14)-(WX(A)+30+C1*30,WY(A)+20),PSET,0,BF,[CO(C1,0),CO(C1,1),CO(C1,2)]:LINE(WX(A)+2+COC*9,WY(A)+41)-(WX(A)+9+COC*9,WY(A)+48),PSET,[CO(C1,0),CO(C1,1),CO(C1,2)],BF
  233. 2330 NEXT
  234. 2340 ELSE
  235. 2350 PSET(CX+C1X,CY+C1Y),[CO(C1,0),CO(C1,1),CO(C1,2)],PASTEL:SCREEN 1,1:LINE(WX(0)+1+CX*LP2,WY(0)+13+CY*LP2)-(WX(0)+CX*LP2+LP2,WY(0)+CY*LP2+LP2+12),PASTEL,[CO(C1,0),CO(C1,1),CO(C1,2)],BF
  236. 2360 ENDIF
  237. 2370 IF PE<>1 AND OP(10)>1 THEN SCREEN 1,0:GET@A(C1X,C1Y)-(C1X+LP-1,C1Y+LP-1),PIC:SCREEN 1,1:PUT@A(WX(0)+1,WY(0)+13)-(WX(0)+LP,WY(0)+12+LP),PIC,,LP2,LP2
  238. 2380 GOTO 1510
  239. 2390 ELSE
  240. 2400 '★サイズ
  241. 2410 IF CCX<47 AND CCY>LP*LP2+14 AND CCY<LP*LP2+26 THEN
  242. 2420 CX=INT(CCX/12)+1:LP=CX*16:IF CX=3 THEN LP=64 ELSE IF CX=4 THEN LP=96
  243. 2430 IF CX=1 AND LP2=2 THEN LP2=3
  244. 2440 IF CX=2 AND LP2>6 THEN LP2=6
  245. 2450 IF CX=3 AND LP2>3 THEN LP2=3
  246. 2460 IF CX=4 THEN LP2=2
  247. 2470 W2X(0)=LP*LP2+2:W2Y(0)=W2X(0)+35:W2X(0)=-(W2X(0)>107)*W2X(0)-(W2X(0)<108)*108:GOSUB *W1:GOTO *MAIN
  248. 2480 ENDIF
  249. 2490 IF CCX<47 AND CCY>LP*LP2+25 THEN
  250. 2500 CX=INT(CCX/12)+1:IF CX=1 THEN LP2=2:IF LP=16 THEN LP=32
  251. 2510 IF CX=2 THEN LP2=3:IF LP=96 THEN LP=64
  252. 2520 IF CX=3 THEN LP2=6:IF LP>63 THEN LP=32
  253. 2530 IF CX=4 THEN LP2=12:LP=16
  254. 2540 W2X(0)=LP*LP2+2:W2Y(0)=W2X(0)+35:W2X(0)=-(W2X(0)>107)*W2X(0)-(W2X(0)<108)*108:GOSUB *W1:GOTO *MAIN
  255. 2550 ENDIF
  256. 2560 '点<>調
  257. 2570 IF CCX>84 AND CCY>LP*LP2+13 AND CCX<95 THEN PE=INT((CCY-LP*LP2-13)/12):GOSUB *W1:GOTO *MAIN
  258. 2580 IF CCX>107 AND CCX<119 AND CCY>LP*LP2+13 AND CCY<LP*LP2+25 THEN PE=2:GOSUB *W1
  259. 2590 '★移動
  260. 2600 IF CCX>48 AND CCY>LP*LP2+13 AND CCX<84 THEN
  261. 2610 C2=0:MOUSE 1,,,0:FOR A=0 TO 9:IF WC(A)>0 THEN C2=A
  262. 2620 NEXT
  263. 2630 FOR K=0 TO 1:A=C1Y+LP*K-K:FOR B=C1X+1-K TO C1X+LP-1 STEP 2
  264. 2640 CC=-1:FOR G=0 TO C2:IF WC(G)>0 AND WX(G)<B AND WX(G)+W2X(G)>B AND WY(G)<A AND WY(G)+W2Y(G)>A THEN CC=0:G=9
  265. 2650 NEXT:IF CC=-1 AND NOT(B<340 AND A<16) THEN PSET(B,A),[0,0,0,1]
  266. 2660 NEXT:NEXT
  267. 2670 FOR K=0 TO 1:B=C1X+LP*K-K:FOR A=C1Y+K TO C1Y+LP-1 STEP 2
  268. 2680 CC=-1:FOR G=0 TO C2:IF WC(G)>0 AND WX(G)<=B AND WX(G)+W2X(G)=>B AND WY(G)<=A AND WY(G)+W2Y(G)=>A THEN CC=0:G=9
  269. 2690 NEXT:IF CC=-1 AND NOT(B<340 AND A<16) THEN PSET(B,A),[0,0,0,1]
  270. 2700 NEXT:NEXT
  271. 2710 IF CCX<60 THEN C1X=C1X-LP/2:IF C1X<0 THEN C1X=0
  272. 2720 IF CCX>72 THEN C1X=C1X+LP/2:IF C1X>320-LP THEN C1X=320-LP
  273. 2730 IF CCX>59 AND CCX<73 AND CCY<LP*LP2+25 THEN C1Y=C1Y-LP/2:IF C1Y<0 THEN C1Y=0
  274. 2740 IF CCX>59 AND CCX<73 AND CCY>LP*LP2+24 THEN C1Y=C1Y+LP/2:IF C1Y>240-LP THEN C1Y=240-LP
  275. 2750 FOR K=0 TO 1:B=C1X+LP*K-K:FOR A=C1Y+K TO C1Y+LP-1 STEP 2
  276. 2760 CC=-1:FOR G=0 TO C2:IF WC(G)>0 AND WX(G)<=B AND WX(G)+W2X(G)=>B AND WY(G)<=A AND WY(G)+W2Y(G)=>A THEN CC=0:G=9
  277. 2770 NEXT:IF CC=-1 AND NOT(B<340 AND A<16) THEN PSET(B,A),7
  278. 2780 NEXT:NEXT
  279. 2790 FOR K=0 TO 1:A=C1Y+LP*K-K:FOR B=C1X+1-K TO C1X+LP-1 STEP 2
  280. 2800 CC=-1:FOR G=0 TO C2:IF WC(G)>0 AND WX(G)<=B AND WX(G)+W2X(G)=>B AND WY(G)<=A AND WY(G)+W2Y(G)=>A THEN CC=0:G=9
  281. 2810 NEXT:IF CC=-1 AND NOT(B<340 AND A<16)THEN PSET(B,A),7
  282. 2820 NEXT:NEXT:SCREEN 1,0:GET@A(C1X,C1Y)-(C1X+LP-1,C1Y+LP-1),PIC:SCREEN 1,1:PUT@A(WX(0)+1,WY(0)+13)-(WX(0)+LP,WY(0)+12+LP),PIC,,LP2,LP2:MOUSE 1,,,1
  283. 2830 ENDIF
  284. 2840 IF CCX>96 AND CCY>LP*LP2+13 AND CCX<107 AND CCY<LP*LP2+25 THEN LPC=0:GOSUB *W1
  285. 2850 IF CCX>96 AND CCY>LP*LP2+25 AND CCX<107 AND CCY<LP*LP2+37 THEN LPC=1:LPC2=1-LPC2:GOSUB *W1
  286. 2860 IF CCX>108 AND CCY>LP*LP2+25 AND CCX<119 AND CCY<LP*LP2+37 THEN LPC3=1-LPC3:LINE(WX(0)+108,WY(0)+LP*LP2+25)-(WX(0)+119,WY(0)+LP*LP2+36),XOR,7,BF
  287. 2870 ENDIF
  288. 2880 GOTO *MAIN
  289. 2890 *カラー
  290. 2900 IF CCX>4 AND CCY>22 AND CCY<40 THEN
  291. 2910 CX=INT((CCX-5)/3)*9:CY=INT((CCY-22)/6)
  292. 2920 CO(2,CY)=INT(CX/8)*8:IF CO(2,CY)>248 THEN CO(2,CY)=248
  293. 2930 LINE(WX(0)+64,WY(0)+14)-(WX(0)+90,WY(0)+20),PSET,0,BF,[CO(2,0),CO(2,1),CO(2,2)]:FOR A=0 TO 2:LINE(WX(0)+3,WY(0)+22+A*6)-(WX(0)+91,WY(0)+27+A*6),PSET,0,BF,3-A-(A=0):NEXT
  294. 2940 FOR A=0 TO 2:LINE(WX(0)+4+CO(2,A)/3,WY(0)+23+A*6)-(WX(0)+7+CO(2,A)/3,WY(0)+26+A*6),PSET,7,B:NEXT:GOTO *MAIN
  295. 2950 ENDIF
  296. 2960 IF CCY>14 AND CCY<20 THEN 
  297. 2970 IF CCX>68 AND CCX<96 THEN 
  298. 2980 FOR A=0 TO 2:LINE(WX(0)+3,WY(0)+22+A*6)-(WX(0)+91,WY(0)+27+A*6),PSET,0,BF,3-A-(A=0):NEXT
  299. 2990 CO(2,0)=CO(C1,0):CO(2,1)=CO(C1,1):CO(2,2)=CO(C1,2):LINE(WX(0)+64,WY(0)+14)-(WX(0)+90,WY(0)+20),PSET,0,BF,[CO(2,0),CO(2,1),CO(2,2)]:FOR A=0 TO 2:LINE(WX(0)+4+CO(2,A)/3,WY(0)+23+A*6)-(WX(0)+7+CO(2,A)/3,WY(0)+26+A*6),PSET,7,B:NEXT:GOTO *MAIN
  300. 3000 ENDIF
  301. 3010 IF CCX>4 AND CCX<30 THEN
  302. 3020 CO(0,0)=CO(2,0):CO(0,1)=CO(2,1):CO(0,2)=CO(2,2):LINE(WX(0)+4,WY(0)+14)-(WX(0)+30,WY(0)+20),PSET,0,BF,[CO(0,0),CO(0,1),CO(0,2)]
  303. 3030 IF COC2=0 THEN COC(COC,0)=CO(0,0):COC(COC,1)=CO(0,1):COC(COC,2)=CO(0,2):LINE(WX(0)+2+COC*9,WY(0)+41)-(WX(0)+9+COC*9,WY(0)+48),PSET,[CO(0,0),CO(0,1),CO(0,2)],BF
  304. 3040 ENDIF
  305. 3050 IF CCX>34 AND CCX<60 THEN
  306. 3060 CO(1,0)=CO(2,0):CO(1,1)=CO(2,1):CO(1,2)=CO(2,2):LINE(WX(0)+34,WY(0)+14)-(WX(0)+60,WY(0)+20),PSET,0,BF,[CO(1,0),CO(1,1),CO(1,2)]
  307. 3070 IF COC2=1 THEN COC(COC,0)=CO(1,0):COC(COC,1)=CO(1,1):COC(COC,2)=CO(1,2):LINE(WX(0)+2+COC*9,WY(0)+41)-(WX(0)+9+COC*9,WY(0)+48),PSET,[CO(1,0),CO(1,1),CO(1,2)],BF
  308. 3080 ENDIF
  309. 3090 ENDIF
  310. 3100 IF CCY>40 AND CCX>1 AND CCX<90 AND CCY<49 THEN 
  311. 3110 LINE(WX(0)+1+COC*9,WY(0)+40)-(WX(0)+10+COC*9,WY(0)+49),PSET,0,B:COC=INT((CCX-1)/9):LINE(WX(0)+1+COC*9,WY(0)+40)-(WX(0)+10+COC*9,WY(0)+49),PSET,7,B:COC2=C1
  312. 3120 CO(C1,0)=COC(COC,0):CO(C1,1)=COC(COC,1):CO(C1,2)=COC(COC,2):LINE(WX(0)+4+C1*30,WY(0)+14)-(WX(0)+30+C1*30,WY(0)+20),PSET,0,BF,[CO(C1,0),CO(C1,1),CO(C1,2)]
  313. 3130 ENDIF
  314. 3140 GOTO *MAIN
  315. 3150 *ファイル
  316. 3160 IF PICBAK=1 THEN SCREEN 1,0:GET@A(0,0)-(511,239),PICBAK
  317. 3170 CCY=INT(CCX/16)+1:SCREEN 1,0:OUT &H440,17:OUT &H442,0:OUT &H440,21:OUT &H442,0:GET@A(0,0)-(319,239),PIC:GOSUB *CLS:DIR=0
  318. 3180 IF CCY=3 AND JP=1 THEN MOUSE 1,,,0:SCREEN 0:BEEP:SYMBOL(0,0),"メモリが足りません｡他のＳＡＶＥを使用してください｡",.75!,.75!,2:Q$=INPUT$(1):GOTO 3600
  319. 3190 MOUSE 1,,,0:SCREEN 0:CONSOLE 0,24,2:PRINT "ドライブ名?";:A$=INPUT$(1):IF A$=CHR$(13) THEN 3600
  320. 3200 CC=ASC(A$):IF CC>96 THEN CC=CC-32:A$=CHR$(CC)
  321. 3210 IF A$="Q" AND CCY>1 THEN PRINT "Ｑドライブには書き込めません":GOTO 3190
  322. 3220 PRINT A$:IF CC<65 OR CC>81 THEN 3190
  323. 3230 PRINT KMID$("     LOAD     SAVE   圧縮SAVEJPEGSAVE JPEGLOAD",CCY*9-8,9)
  324. 3240 ON ERROR GOTO *ER1:SHELL A$+":":PRINT :IF DIR=0 THEN FILES"*.*" ELSE IF DIR=1 THEN IF CCY<4 THEN FILES"*.TIF" ELSE FILES"*.JPG"
  325. 3250 IF MEM$<>"" THEN PRINT "前回入力したファイル名　";MEM$
  326. 3260 PRINT "命令一覧: CD (ﾃﾞｨﾚｸﾄﾘ変更)   DIR  (拡張子判別の"+MID$("ON OFF",1+DIR*3,3)+")"
  327. 3270 LINE INPUT "ﾌｧｲﾙ or 命令？　";F$:IF LEFT$(F$,2)="CD" OR LEFT$(F$,2)="cd" THEN SHELL F$:GOTO 3240
  328. 3280 IF RIGHT$(F$,1)=":" THEN A$=LEFT$(F$,1):GOTO 3240
  329. 3290 IF LEFT$(F$,3)="DIR" THEN DIR=1-DIR:GOTO 3240
  330. 3300 IF F$="" THEN 3600
  331. 3310 IF CCY=4 THEN
  332. 3320 INPUT "圧縮比率(1 OR 2 OR 4)";Y1:IF Y1<>1 AND Y1<>2 AND Y1<>4 THEN 3320
  333. 3330 INPUT "輝度成分(0-100)";Y2:IF Y2<0 OR Y2>100 THEN 3330
  334. 3340 INPUT "色成分  (0-100)";Y3:IF Y3<0 OR Y3>100 THEN 3340
  335. 3350 ENDIF
  336. 3360 SCREEN 1,1:SCREEN @1:ON ERROR GOTO *ER2:WINDOW(0,0)-(511,239):VIEW(0,0)-(511,239):SCREEN 1,0:WINDOW(0,0)-(511,239):VIEW(0,0)-(511,239):PUT@A(0,0)-(319,239),PIC:MEM$=F$:IF CCY>1 AND CCY<5 THEN 3530
  337. 3370 SCREEN 1,1:DEF FONT S16$:LINE(50,50)-(200,170),PSET,[128,128,128],BF:SYMBOL(71,51),"読み込み方",1,1,6:SYMBOL(51,71),"普通",1,1,7:SYMBOL(51,91),"黒色を除く",1,1,7:SYMBOL(51,111),"左色を除く",1,1,7
  338. 3380 SYMBOL(51,131),"透明に重ねる",1,1,7:SYMBOL(51,151),"左色以外を除く",1,1,7:MOUSE 0,1:MOUSE 1,0,0,1:MOUSE 4,50,71,200,169:GOSUB *形状
  339. 3390 CY=MOUSE(1):IF MOUSE(2,0)=0 THEN 3390
  340. 3400 QC=INT((CY-70)/20):SE$="":GOSUB *コメ:LINE(CX,CY)-(511,239),XOR,7,B:IF MJC=1 THEN DEF FONT S12$
  341. 3410 GOSUB *コメント:CX=INT(CX/SI)*SI:CY=INT(CY/SI)*SI:IF IX<>CX OR IY<>CY THEN LINE(IX,IY)-(511,239),XOR,7,B:LINE(CX,CY)-(511,239),XOR,7,B:IX=CX:IY=CY
  342. 3420 IF MOUSE(2,1)=-1 THEN LINE(CX,CY)-(511,239),XOR,7,B:GOTO 3600
  343. 3430 IF MOUSE(2,0)=0 THEN 3410
  344. 3440 LINE(CX,CY)-(511,239),XOR,7,B:SCREEN 1,1:LINE(0,0)-(511,239),PSET,[0,0,0,1],BF:MOUSE 1,,,0:SCREEN 1,1+(QC=0):IF CCY=5 THEN LOAD@ F$+".JPG",(CX,CY) ELSE LOAD@ F$+".TIF",(CX,CY)
  345. 3450 GET@A(0,0)-(319,239),PIC
  346. 3460 '★黒除き
  347. 3470 IF QC=0 THEN 3600
  348. 3480 SCREEN 1,0:IF QC=1 THEN PUT@A(0,0)-(319,239),PIC,MATTE,,,[0,0,0]:IF OP(8)=1 THEN SCREEN 1,1:GET@A(320,0)-(511,239),PIC:SCREEN 1,0:PUT@A(320,0)-(511,239),PIC,MATTE,,,[0,0,0]
  349. 3490 IF QC=2 THEN PUT@A(0,0)-(319,239),PIC,MATTE,,,[CO(0,0),CO(0,1),CO(0,2)]:IF OP(8)=1 THEN SCREEN 1,1:GET@A(320,0)-(511,239),PIC:SCREEN 1,0:PUT@A(320,0)-(511,239),PIC,MATTE,,,[CO(0,0),CO(0,1),CO(0,2)]
  350. 3500 IF QC=3 THEN PUT@A(0,0)-(319,239),PIC,PASTEL:IF OP(8)=1 THEN SCREEN 1,1:GET@A(320,0)-(511,239),PIC:SCREEN 1,0:PUT@A(320,0)-(511,239),PIC,PASTEL
  351. 3510 IF QC=4 THEN SCREEN 1,1:GET@(0,0)-(511,239),PIC,[CO(0,0),CO(0,1),CO(0,2)]:SCREEN 1,0:PUT@(0,0)-(511,239),PIC,PSET,[CO(0,0),CO(0,1),CO(0,2)]
  352. 3520 SCREEN 1,0:GET@A(0,0)-(319,239),PIC:GOTO 3600
  353. 3530 GOSUB *コメ:SE$="":LINE(0,0)-(CX,CY),XOR,7,B
  354. 3540 GOSUB *コメント:CX=INT((CX+1)/SI)*SI-1:CY=INT((CY+1)/SI)*SI-1:IF CX<>IX OR CY<>IY THEN LINE(0,0)-(IX,IY),XOR,7,B:LINE(0,0)-(CX,CY),XOR,7,B:IX=CX:IY=CY
  355. 3550 IF MOUSE(2,1)=-1 THEN LINE(0,0)-(CX,CY),XOR,7,B:GOTO 3600
  356. 3560 IF MOUSE(2,0)=0 THEN 3540
  357. 3570 LINE(0,0)-(CX,CY),XOR,7,B:MOUSE 1,,,0:SCREEN 1,0:IF CCY=3 THEN 3620
  358. 3580 IF CCY=4 THEN 3650
  359. 3590 C$=".TIF":SAVE@ A$+":"+F$+C$,(0,0)-(CX,CY):GOTO 3600
  360. 3600 SCREEN 1,0:ON ERROR GOTO 0:PUT@A(0,0)-(319,239),PIC:DEF PEN 0,OP(10):IF PICBAK=2 THEN DIM PICBAK(122880):GET@A(0,0)-(511,239),PICBAK:PICBAK=1
  361. 3610 SCREEN 1,1:SCREEN @1:GOSUB *W1:GOTO *MAIN
  362. 3620 IF PICBAK=1 THEN ERASE PICBAK:PICBAK=2
  363. 3630 C$=".TIF":SAVE@ A$+":"+F$+C$,(0,0)-(CX,CY),,1:IF PICBAK=2 THEN DIM PICBAK(122880):GET@A(0,0)-(511,239),PICBAK:PICBAK=1
  364. 3640 GOTO 3600
  365. 3650 C$=".JPG":SAVE@ A$+":"+F$+C$,(0,0)-(CX,CY),,2,Y1,Y2,Y3:GOTO 3600
  366. 3660 *ER1
  367. 3670 BEEP:PRINT "指定のファイル 又は ドライブが存在しません｡":IF CCY=2 OR CCY=3 OR CCY=4 THEN RESUME 3250 ELSE Q$=INPUT$(1):RESUME 3190
  368. 3680 *ER2
  369. 3690 MOUSE 1,,,0:SCREEN 0:CONSOLE 0,24,2:GOSUB *CLS:BEEP
  370. 3700 IF CCY=3 AND PICBAK=2 THEN PUT@A(0,0)-(319,239),PIC:DIM PICBAK(122880):GET@A(0,0)-(511,239),PICBAK:PICBAK=1:GOSUB *CLS
  371. 3710 IF ERR=63 THEN PRINT "指定のファイルが見つかりません":RESUME 3240
  372. 3720 IF ERR=64 THEN
  373. 3730 PRINT "指定のファイルは存在しています｡":PRINT "1)続行する 2)その絵を見る 3)中止する":Q$=INPUT$(1):GOSUB *CLS
  374. 3740 IF Q$="1" THEN PUT@A(0,0)-(319,239),PIC:KILL A$+":"+F$+C$:RESUME
  375. 3750 IF Q$="2" THEN LOAD@ A$+":"+F$+C$:Q$=INPUT$(1):GOSUB *CLS:GOTO 3730 ELSE RESUME 3600
  376. 3760 ENDIF
  377. 3770 IF ERR=60 OR ERR=53 OR ERR=72 THEN PRINT "ディスクを正しくセットして下さい":Q$=INPUT$(1):RESUME 3190
  378. 3780 IF ERR=55 THEN PRINT "正しくファイル名を指定してください｡":RESUME 3240 
  379. 3790 IF ERR=112 THEN PRINT "このファイルは このツールでは読み込めません｡":Q$=INPUT$(1):RESUME 3190
  380. 3800 IF ERR=73 THEN PRINT "ディスクの書き込みが禁止されています｡":RESUME 3240
  381. 3810 IF ERR=75 THEN PRINT "アクセスが拒否されました｡":RESUME 3240
  382. 3820 IF ERR=28 THEN PRINT "サイドワークを設定しないとＪＰＥＧ形式は使えません｡":Q$=INPUT$(1):RESUME 3190
  383. 3830 IF ERR=89 THEN PRINT "システム用作業領域が一杯になりました｡":PRINT "サイドワークを外してください｡":Q$=INPUT$(1):RESUME 3190
  384. 3840 IF ERR=67 THEN PRINT "ディスクの容量が足りません｡":Q$=INPUT$(1):RESUME 3190
  385. 3850 PRINT "エラー番号";ERR;"のエラーが";ERL;"行で発生しました｡":PRINT "HIT ANY KEY":Q$=INPUT$(1):RESUME 3190
  386. 3860 *その他
  387. 3870 CCY=INT(CCX/16)+1:ON CCY GOTO 3880,3920,3940,*アニメ
  388. 3880 IF PICBAK=1 THEN SCREEN 1,0:GET@A(0,0)-(511,239),PICBAK
  389. 3890 BEEP:SE$="絵を消していいですか｡":GOSUB *YN:IF QC=1 THEN 3910
  390. 3900 SE$="絵は保存されません｡":BEEP:GOSUB *YN:IF QC=0 THEN SCREEN 1,0:LINE(0,0)-(511,239),PSET,0,BF
  391. 3910 GOSUB *W1:GOTO *MAIN
  392. 3920 ON ERROR GOTO *ERRCD:CDC=1-CDC:IF CDC=1 THEN CD PLAY ELSE CD STOP
  393. 3930 ON ERROR GOTO 0:GOTO *MAIN
  394. 3940 C2=0:PE=0:OUT &H440,17:OUT &H442,0:OUT &H440,21:OUT &H442,0
  395. 3950 LINE(10,20)-(310,225),PSET,7,BF:LINE(10,20)-(21,31),PSET,[96,96,96],BF:LINE(10,20)-(21,31),PSET,0:MOUSE 1,,,0:MOUSE 4,10,20,310,225:DEF FONT S16$
  396. 3960 FOR A=0 TO 2:LINE(40+A*72,20)-(111+A*72,34),PSET,7,BF,[96,96,96]:NEXT:SYMBOL(41,21),"ﾃﾞｰﾀｰのSAVE 色の初期化　ｵﾌﾟｼｮﾝ初期化",.75!,.75!,0:LINE(260,20)-(300,33),PSET,[96,96,96],BF:SYMBOL(260,20),"ﾍﾟｰｼﾞ",1,1,0
  397. 3970 IF PE=0 THEN
  398. 3980 SYMBOL(11,35),"範囲指定のサイズ",1,1,0:SYMBOL(11,51),"混合比率",1,1,0:SYMBOL(11,67),"色入替えの許容差　緑",1,1,0:SYMBOL(119,83),"赤",1,1,0:SYMBOL(119,99),"青",1,1,0
  399. 3990 SYMBOL(11,115),"色入替え変換色 0)同じ 1)変化",1,1,0:SYMBOL(11,131),"霧拭き範囲",1,1,0:SYMBOL(11,147),"アニメーションの間隔",1,1,0:SYMBOL(11,163),"横の大きさ 0)320ﾄﾞｯﾄ 1)512ﾄﾞｯﾄ",1,1,0
  400. 4000 SYMBOL(11,179),"編集時の拡大倍率",1,1,0:SYMBOL(11,195),"ペンの太さ",1,1,0:SYMBOL(11,211),"マウスの形状",1,1,0
  401. 4010 ELSE
  402. 4020 SYMBOL(11,35),"ﾀｲﾄﾙｸﾞﾗﾌｨｯｸ表示 0)OFF 1)ON",1,1,0:SYMBOL(11,51),"表示を簡素化 0)しない 1)する",1,1,0
  403. 4030 ENDIF
  404. 4040 FOR A=PE*12 TO -11*(PE=0)-OP*(PE=1):SYMBOL(245,A*16+35-PE*192),"↓↑",1,1,0:SYMBOL(277,A*16+35-PE*192),STR$(OP(A)),1,1,0:NEXT:MOUSE 1,,,1
  405. 4050 CX=MOUSE(0):CY=MOUSE(1)
  406. 4060 IF MOUSE(2,0)=0 THEN C2=0:GOTO 4050
  407. 4070 IF CX<22 AND CY<31 THEN 
  408. 4080 KN=OP(13):SCREEN 1,0:DEF PEN 0,OP(10):MOUSE 4,0,0,319,239:GOSUB *W1:SI=OP(0):FOR A=0 TO 1:SCREEN 1,A:PASTEL OP(1):NEXT:IF MJC=1 THEN DEF FONT S12$
  409. 4090 GOTO *MAIN
  410. 4100 ENDIF
  411. 4110 IF CX>260 AND CX<300 AND CY<34 THEN PE=1-PE:GOTO 3950
  412. 4120 IF CX>40 AND CX<255 AND CY<34 THEN
  413. 4130 CX=INT((CX-40)/72):CC=0:IF CX=1 THEN RESTORE *R1:FOR A=0 TO 9:READ COC(A,0),COC(A,1),COC(A,2):NEXT:GOTO 4050
  414. 4140 IF CX=2 THEN RESTORE *R2:FOR A=0 TO 11:READ OP(A):NEXT:SI=OP(0):GOTO 3940
  415. 4150 '★ｵﾌﾟｼｮﾝSAVE
  416. 4160 LINE(50,50)-(120,83),PSET,0,BF,7:SYMBOL(51,51),CHR$(65+CC)+"ﾄﾞﾗｲﾌﾞ",1,1,0:SYMBOL(51,67),"↓↑決定",1,1,0
  417. 4170 CX=MOUSE(0):CY=MOUSE(1):IF MOUSE(2,1)=-1 THEN 3950
  418. 4180 IF MOUSE(2,0)=0 THEN 4170
  419. 4190 IF NOT(CX>51 AND CX<115 AND CY>67 AND CY<83) THEN 4170
  420. 4200 CX=INT((CX-51)/16):IF CX=0 THEN CC=CC-1:IF CC<0 THEN CC=0
  421. 4210 IF CX=1 THEN CC=CC+1:IF CC>17 THEN CC=17
  422. 4220 IF NOT(CX=2 OR CX=3) THEN 4160
  423. 4230 ON ERROR GOTO *EROPSAVE:SHELL CHR$(65+CC)+":":OPEN "O",#1,"32KEDIT5.DAT"
  424. 4240 WRITE #1,"天使達の筆 Ｖｅｒ ５.００",OP:FOR A=0 TO OP:WRITE #1,OP(A):NEXT:FOR A=0 TO 9:WRITE #1,COC(A,0),COC(A,1),COC(A,2):NEXT:CLOSE #1:ON ERROR GOTO 0:GOTO 3950
  425. 4250 *EROPSAVE
  426. 4260 IF ERR=64 THEN KILL "32KEDIT5.DAT":RESUME 4230
  427. 4270 SE$="SAVEに失敗しました｡再実行しますか｡":GOSUB *YN:IF QC=0 THEN RESUME 4230 ELSE RESUME 3950
  428. 4280 ENDIF
  429. 4290 IF CX>245 AND CX<277 AND CY>35 THEN CX=INT((CX-245)/16):CY=INT((CY-35)/16)+PE*12 ELSE 4050
  430. 4300 IF CY>OP THEN CY=OP
  431. 4310 OP(CY)=OP(CY)+CX*2-1:IF OP(0)<1 THEN OP(0)=1
  432. 4320 IF OP(CY)<1 AND (CY=7 OR CY=10 OR CY=9) THEN OP(CY)=1
  433. 4330 IF OP(7)>99 THEN OP(7)=99
  434. 4340 IF CY>0 AND CY<5 THEN OP(CY)=OP(CY)+CX*7:OP(CY)=INT(OP(CY)/8)*8
  435. 4350 IF OP(CY)<0 THEN OP(CY)=0
  436. 4360 IF OP(CY)>256 THEN OP(CY)=256
  437. 4370 IF OP(0)>64 THEN OP(0)=64
  438. 4380 IF OP(CY)>1 AND (CY=5 OR CY=8 OR CY=12 OR CY=13) THEN OP(CY)=1
  439. 4390 IF OP(9)>15 THEN OP(9)=15
  440. 4400 IF OP(10)>32 THEN OP(10)=32
  441. 4410 IF OP(11)>2 THEN OP(11)=2
  442. 4420 IF CY=11 THEN
  443. 4430 CX=MOUSE(0):CY=MOUSE(1):MOUSE 0,1:GOSUB *形状
  444. 4440 MOUSE 1,CX,CY,1:MOUSE 4,10,20,310,50+OP*16:CY=11
  445. 4450 ENDIF
  446. 4460 LINE(277,CY*16+35-PE*192)-(309,CY*16+50-PE*192),PSET,7,BF:SYMBOL(277,CY*16+35-PE*192),STR$(OP(CY)),1,1,0:WAIT 2:IF C2=0 THEN WAIT 15:C2=1
  447. 4470 GOTO 4050
  448. 4480 *ERRCD
  449. 4490 RESUME 3930
  450. 4500 *アニメ
  451. 4510 CC=0:CCX=SI:CCY=SI
  452. 4520 SE$="ｱﾆﾒｰｼｮﾝする場所指定"+STR$(CC+1):GOSUB *コメ:LINE(CX,CY)-(CX+CCX,CY+CCY),XOR,7,B
  453. 4530 GOSUB *コメント:CX=INT(CX/SI)*SI:CY=INT(CY/SI)*SI:IF CX<>IX OR CY<>IY THEN LINE(IX,IY)-(IX+CCX,IY+CCY),XOR,7,B:LINE(CX,CY)-(CX+CCX,CY+CCY),XOR,7,B:IX=CX:IY=CY
  454. 4540 IF MOUSE(2,1)=-1 THEN LINE(CX,CY)-(CX+CCX,CY+CCY),XOR,7,B:IF CC<2 THEN GOSUB *W1:GOTO *MAIN ELSE 4630
  455. 4550 IF MOUSE(2,0)=0 THEN 4530
  456. 4560 LINE(CX,CY)-(CX+CCX,CY+CCY),XOR,7,B:CX(CC)=CX:CY(CC)=CY:WAIT 20:IF CC>0 THEN 4620
  457. 4570 GOSUB *コメント:CX=INT((CX+1)/SI)*SI-1:CY=INT((CY+1)/SI)*SI-1:LINE(CX(0),CY(0))-(CX,CY),XOR,7,B:LINE(CX(0),CY(0))-(CX,CY),XOR,7,B:IF MOUSE(2,1)=-1 THEN GOSUB *W1:GOTO *MAIN
  458. 4580 IF MOUSE(2,0)=0 THEN 4570
  459. 4590 IF CX<CX(0) OR CY<CY(0) THEN 4510
  460. 4600 CCX=CX-CX(0):CCY=CY-CY(0):CC=1:SIZ!=FNSIZ!(CCX,CCY):IF SIZ!>38400 THEN SE$="範囲が広すぎます｡指定を続行しますか":GOSUB *YN:IF QC=0 THEN 4510 ELSE GOSUB *W1:GOTO *MAIN
  461. 4610 GOTO 4520
  462. 4620 CC=CC+1:IF SIZ!*(CC+1)>76800 OR CC>99 THEN CC=CC-1 ELSE 4520
  463. 4630 SCREEN 1,0:FOR A=0 TO CC:GET@A(CX(A),CY(A))-(CX(A)+CCX,CY(A)+CCY),PIC,SIZ!*A:NEXT:SCREEN 1,1:GOSUB *CLS:LINE(159-(CCX+1)/2,119-(CCY+1)/2)-(160+(CCX+1)/2,120+(CCY+1)/2),PSET,7,BF:A=0
  464. 4640 PUT@A(160-(CCX+1)/2,120-(CCY+1)/2)-(159+(CCX+1)/2,119+(CCY+1)/2),PIC,,,,,SIZ!*A:WAIT OP(7):A=A+1:IF A=CC THEN A=0
  465. 4650 IF MOUSE(2,1)=-1 THEN GOSUB *W1:GOTO *MAIN ELSE 4640
  466. 4660 *編集
  467. 4670 SE$="":QC=INT(CCX/16)+INT((CCY-12)/16)*10+1:SCREEN 1,0:IF PICBAK=1 AND QC<>20 THEN GET@A(0,0)-(511,239),PICBAK
  468. 4680 IF QC=17 THEN 4720
  469. 4690 GOSUB *コメ:WAIT 20:IF QC=3 OR QC=6 OR QC=7 THEN 5080 ELSE 4760
  470. 4700 SCREEN 1,0:OUT &H440,17:OUT &H442,0:DEF PEN 0,OP(10):SCREEN 1,1:SCREEN@1:CX=MOUSE(0):CY=MOUSE(1)
  471. 4710 GOSUB *W1:GOTO *MAIN
  472. 4720 OUT &H440,17:OUT &H442,0:OUT &H440,21:OUT &H442,0:SCREEN 1,1:LINE(50,50)-(200,82),PSET,7,BF:SYMBOL(51,50),"上下にｸﾞﾗﾃﾞｰｼｮﾝ",.75!,.75!,0:SYMBOL(51,66),"円状にｸﾞﾗﾃﾞｰｼｮﾝ",.75!,.75!,0:MOUSE 4,50,50,200,81
  473. 4730 IF MOUSE(2,1)=-1 THEN 4700
  474. 4740 C2=INT((MOUSE(1)-50)/16):IF MOUSE(2,0)=0 THEN 4730
  475. 4750 GOSUB *コメ:IF C2=0 THEN 4810 ELSE 5080
  476. 4760 IF QC=20 THEN *復活
  477. 4770 IF QC=11 THEN *字
  478. 4780 IF QC=13 THEN *霧
  479. 4790 IF QC=16 THEN *線
  480. 4800 IF QC=19 THEN *線引き
  481. 4810 SE$="編集する場所を指定":GOSUB *コメ:LINE(CX,CY)-(CX+SI,CY+SI),XOR,7,B
  482. 4820 GOSUB *コメント:CX=INT(CX/SI)*SI:CY=INT(CY/SI)*SI:IF CX<>IX OR CY<>IY THEN LINE(IX,IY)-(IX+SI,IY+SI),XOR,7,B:LINE(CX,CY)-(CX+SI,CY+SI),XOR,7,B:IX=CX:IY=CY
  483. 4830 IF MOUSE(2,1)=-1 THEN LINE(CX,CY)-(CX+SI,CY+SI),XOR,7,B:GOTO 4700
  484. 4840 IF MOUSE(2,0)=0 THEN 4820
  485. 4850 LINE(CX,CY)-(CX+SI,CY+SI),XOR,7,B:CCX=CX:CCY=CY:SE$="場所指定２":GOSUB *コメ:LINE(CCX,CCY)-(CX,CY),XOR,7,B:WAIT 20
  486. 4860 GOSUB *コメント:CX=INT((CX+1)/SI)*SI-1:CY=INT((CY+1)/SI)*SI-1:IF CX<>IX OR CY<>IY THEN LINE(CCX,CCY)-(IX,IY),XOR,7,B:LINE(CCX,CCY)-(CX,CY),XOR,7,B:IX=CX:IY=CY
  487. 4870 IF MOUSE(2,1)=-1 THEN LINE(CCX,CCY)-(CX,CY),XOR,7,B:GOTO 4700
  488. 4880 IF MOUSE(2,0)=0 THEN 4860
  489. 4890 LINE(CCX,CCY)-(CX,CY),XOR,7,B:IF QC=4 THEN LINE(CX,CY)-(CCX,CCY),PSET,[CO(C1,0),CO(C1,1),CO(C1,2)],BF:GOTO 4700
  490. 4900 IF QC=5 THEN LINE(CX,CY)-(CCX,CCY),PSET,[CO(C1,0),CO(C1,1),CO(C1,2)],B:GOTO 4700
  491. 4910 IF QC=17 THEN 5240
  492. 4920 IF (CX-CCX)*(CY-CCY)>76800 OR CCX>CX OR CCY>CY THEN 4810
  493. 4930 GET@A(CCX,CCY)-(CX,CY),PIC:CHX=CCX:CHY=CCY:CCX=CX-CCX:CCY=CY-CCY:WAIT 20:OUT &H440,17:OUT &H442,0:OUT &H440,21:OUT &H442,0
  494. 4940 IF QC=2 THEN *拡大
  495. 4950 IF QC=9 THEN *特別
  496. 4960 IF QC=8 THEN *反転
  497. 4970 IF QC=10 THEN *入替え
  498. 4980 IF QC=12 THEN *明るさ
  499. 4990 IF QC=14 THEN *混合
  500. 5000 IF QC=15 THEN *スプライト
  501. 5010 IF QC=18 THEN *回転
  502. 5020 SE$="複写する場所を指定":GOSUB *コメ:LINE(CX,CY)-(CX+CCX,CY+CCY),XOR,7,B
  503. 5030 GOSUB *コメント:CX=INT(CX/SI)*SI:CY=INT(CY/SI)*SI:IF CX<>IX OR CY<>IY THEN LINE(IX,IY)-(IX+CCX,IY+CCY),XOR,7,B:LINE(CX,CY)-(CX+CCX,CY+CCY),XOR,7,B:IX=CX:IY=CY
  504. 5040 IF MOUSE(2,1)=-1 THEN LINE(CX,CY)-(CX+CCX,CY+CCY),XOR,7,B:GOTO 4700
  505. 5050 IF MOUSE(2,0)=0 THEN 5030
  506. 5060 PUT@A(CX,CY)-(CX+CCX,CY+CCY),PIC,PSET
  507. 5070 LINE(CX,CY)-(CX+CCX,CY+CCY),XOR,7,B:GOTO 5030
  508. 5080 SE$="編集する中心点":GOSUB *コメ
  509. 5090 GOSUB *コメント:IF MOUSE(2,1)=-1 THEN 4700
  510. 5100 IF MOUSE(2,0)=0 THEN 5090
  511. 5110 IF QC=3 THEN PAINT@(CX,CY),[CO(C1,0),CO(C1,1),CO(C1,2)]:GOTO 4700
  512. 5120 CCX=CX:CCY=CY:WAIT 20:Y1=CO(C1,0):Y2=CO(C1,1):Y3=CO(C1,2)
  513. 5130 CX=ABS(CCY+CCX-MOUSE(0)-MOUSE(1)):CIRCLE(CCX,CCY),CX,[Y1,Y2,Y3],,,,,XOR:CIRCLE(CCX,CCY),CX,[Y1,Y2,Y3],,,,,XOR:IF MOUSE(2,1)=-1 THEN 4700
  514. 5140 IF MOUSE(2,0)=0 THEN 5130
  515. 5150 IF QC=6 THEN CIRCLE(CCX,CCY),CX,[Y1,Y2,Y3]:GOTO 4700
  516. 5160 IF QC=7 THEN CIRCLE(CCX,CCY),CX,[Y1,Y2,Y3],,,,F:GOTO 4700
  517. 5170 IF QC=17 THEN '★ｸﾞﾗﾃﾞｰｼｮﾝ★
  518. 5180 ON ERROR GOTO *ERG
  519. 5190 Y1!=INT((CO(0,0)-CO(1,0))/CX):Y2!=INT((CO(0,1)-CO(1,1))/CX):Y3!=INT((CO(0,2)-CO(1,2))/CX):MOUSE 1,,,0
  520. 5200 FOR A=CX-4 TO 0 STEP -1:CIRCLE(CCX,CCY),A,[CO(0,0)-Y1!*A,CO(0,1)-Y2!*A,CO(0,2)-Y3!*A],,,,F:NEXT
  521. 5210 ON ERROR GOTO 0
  522. 5220 ENDIF
  523. 5230 GOTO 4700
  524. 5240 '★ｸﾞﾗﾃﾞ2
  525. 5250 CC=ABS(CY-CCY):Y1!=(CO(0,0)-CO(1,0))/CC:Y2!=(CO(0,1)-CO(1,1))/CC:Y3!=(CO(0,2)-CO(1,2))/CC:MOUSE 1,,,0
  526. 5260 FOR A=0 TO CC:C1=CO(0,0)-Y1!*A-1:C1=-(C1>0)*C1:C2=CO(0,1)-Y2!*A:C2=-(C2<255)*C2-(C2>254)*255:C3=CO(0,2)-Y3!*A+1:C3=-(C3<255)*C3-(C3>254)*255
  527. 5270 LINE(CCX,A+CCY)-(CX,A+CCY),PSET,[C1,C2,C3]:NEXT:GOTO 4700
  528. 5280 *ERG
  529. 5290 BEEP:SE$="実行時エラーが発生しました":GOSUB *YN:RESUME 4700
  530. 5300 *特別
  531. 5310 SCREEN 1,1:MOUSE 0,1:MOUSE 1,,,1:DEF FONT S16$:LINE(50,50)-(200,110),PSET,7,BF:SYMBOL(71,51),"特別処理",1,1,1:SYMBOL(51,70),"ぼかし処理",1,1,0:SYMBOL(51,90),"モノクロ",1,1,0:GOSUB *形状:MOUSE 4,50,70,200,109
  532. 5320 CX=MOUSE(0):CY=MOUSE(1)
  533. 5330 IF MOUSE(2,1)=-1 THEN 4700
  534. 5340 IF MOUSE(2,0)=0 THEN 5320
  535. 5350 CY=INT((CY-70)/20):MOUSE 1,,,0:LINE(CHX,CHY)-(CHX+CCX,CHY+CCY),PSET,0,BF:IF CY=1 THEN 5430
  536. 5360 C4=-(OP(8)=1)*512-(OP(8)=0)*320:FOR Y=CHY TO CHY+CCY:FOR X=CHX TO CHX+CCX:C=1
  537. 5370 CC!=X*2+Y*1024:C3=PEEK([&H1C]CC!):C2=PEEK([&H1C]CC!+1):B=(C3 AND 31):G=((C2 AND 127)-(C2 AND 3)):R=INT(((C2 AND 3)*64+(C3/8)*2)/8)
  538. 5380 FOR A1=-1 TO 1 STEP 2:FOR A2=-1 TO 1 STEP 2
  539. 5390 IF X+A2>-1 AND X+A2<C4 AND Y+A1>-1 AND Y+A1<240 THEN CC!=(X+A2)*2+Y*1024:C3=PEEK([&H1C]CC!):B=B+(C3 AND 31):C2=PEEK([&H1C]CC!+1):G=G+((C2 AND 127)-(C2 AND 3)):R=R+INT(((C2 AND 3)*64+(C3/8)*2)/8):C=C+1
  540. 5400 NEXT:NEXT
  541. 5410 G=INT(G/C)*2:G=-(G<255)*G-(G>254)*255:R=INT(R/C)*8:R=-(R<255)*R-(R>254)*255:B=INT(B/C)*8:B=-(B<255)*B-(B>254)*255:PSET(X,Y),[G,R,B]:NEXT:NEXT
  542. 5420 GET@A(CHX,CHY)-(CHX+CCX,CHY+CCY),PIC:SCREEN 1,0:PUT@A(CHX,CHY)-(CHX+CCX,CHY+CCY),PIC:GOTO 4700
  543. 5430 FOR Y=CHY TO CHY+CCY:FOR X=CHX TO CHX+CCX:CC!=X*2+Y*1024:C3=PEEK([&H1C]CC!):C2=PEEK([&H1C]CC!+1):B=(C3 AND 31)*8:G=((C2 AND 127)-(C2 AND 3))*2:R=INT(((C2 AND 3)*64+(C3/8)*2)/8)*8
  544. 5440 C=INT((B+G+R)/3):C=-(C<255)*C-(C>254)*255:PSET(X,Y),[C,C,C]:NEXT:NEXT:GOTO 5420
  545. 5450 *線
  546. 5460 CC=0:SE$="線を描く場所":GOSUB *コメ
  547. 5470 GOSUB *コメント:IF MOUSE(2,1)=-1 THEN 4700
  548. 5480 IF MOUSE(2,0)=0 THEN CC=0:GOTO 5470
  549. 5490 IF CC=0 THEN CCX=CX:CCY=CY:CC=1
  550. 5500 LINE(CCX,CCY)-(CX,CY),PSET,[CO(C1,0),CO(C1,1),CO(C1,2)]:CCX=CX:CCY=CY:GOTO 5470
  551. 5510 *線引き
  552. 5520 SE$="線を引く場所":GOSUB *コメ
  553. 5530 GOSUB *コメント:IF MOUSE(2,1)=-1 THEN 4700
  554. 5540 IF MOUSE(2,0)=0 THEN 5530
  555. 5550 CCX=CX:CCY=CY
  556. 5560 GOSUB *コメント:IF MOUSE(2,1)=-1 THEN WAIT 20:GOTO 5530
  557. 5570 LINE(CCX,CCY)-(CX,CY),XOR,7:WAIT 3:LINE(CCX,CCY)-(CX,CY),XOR,7:IF MOUSE(2,0)=0 THEN 5560
  558. 5580 LINE(CCX,CCY)-(CX,CY),PSET,[CO(C1,0),CO(C1,1),CO(C1,2)]:WAIT 20:CCX=CX:CCY=CY:GOTO 5560
  559. 5590 *拡大
  560. 5600 SCREEN 1,1:BX!=1:BY!=1:CX=MOUSE(0):CY=MOUSE(1):MOUSE 0,1:MOUSE 1,CX,CY,1:MOUSE 4,0,0,-511*(OP(8)=1)-319*(OP(8)=0),239:DEF FONT S16$:C1=0
  561. 5610 MOUSE 1,,,0:PUT@A(0,0)-(CCX,CCY),PIC,,BX!,BY!:LINE(100,100)-(300,179),PSET,7,BF:SYMBOL(110,110),"倍率",1,1,0:FOR A=0 TO 1:SYMBOL(120,130+A*20),"↓",1,1,0:SYMBOL(180,130+A*20),"↑",1,1,0:NEXT
  562. 5620 SYMBOL(220,100),"複写方式",1,1,1:SYMBOL(220,120),"普通",1,1,0:SYMBOL(220,140),"左色除く",1,1,0:SYMBOL(220,160),"透過",1,1,0:LINE(219,119+C1*20)-(285,136+C1*20),PSET,1,B
  563. 5630 SYMBOL(135,130),STR$(BX!),1,1,0:SYMBOL(135,150),STR$(BY!),1,1,0:MOUSE 1,,,1
  564. 5640 CX=MOUSE(0):CY=MOUSE(1):IF MOUSE(2,1)=-1 THEN 5740
  565. 5650 IF MOUSE(2,0)=0 THEN 5640
  566. 5660 IF CY>120 AND CY<179 AND CX>220 AND CX<285 THEN C1=INT((CY-120)/20):GOTO 5610
  567. 5670 IF CY<130 OR CY>159 THEN 5640
  568. 5680 CY=INT((CY-130)/20)
  569. 5690 CC!=0:IF CX>120 AND CX<140 THEN CC!=-1
  570. 5700 IF CX>180 AND CX<200 THEN CC!=1
  571. 5710 IF CY=0 THEN BX!=INT(BX!*10+CC!-(CC!=.1!))/10:IF BX!=0 THEN BX!=.1!
  572. 5720 IF CY=1 THEN BY!=INT(BY!*10+CC!-(CC!=.1!))/10:IF BY!=0 THEN BY!=.1!
  573. 5730 GOTO 5610
  574. 5740 GOSUB *コメ:SE$="複写する場所指定":LINE(CX,CY)-(CX+CCX*BX!,CY+CCY*BY!),XOR,7,B
  575. 5750 GOSUB *コメント:CX=INT(CX/SI)*SI:CY=INT(CY/SI)*SI:IF CX<>IX OR CY<>IY THEN LINE(IX,IY)-(IX+CCX*BX!,IY+CCY*BY!),XOR,7,B:LINE(CX,CY)-(CX+CCX*BX!,CY+CCY*BY!),XOR,7,B:IX=CX:IY=CY
  576. 5760 IF MOUSE(2,1)=-1 THEN LINE(CX,CY)-(CX+CCX*BX!,CY+CCY*BY!),XOR,7,B:GOTO 4700
  577. 5770 IF MOUSE(2,0)=0 THEN 5750
  578. 5780 LINE(CX,CY)-(CX+CCX*BX!,CY+CCY*BY!),XOR,7,B:IF C1=0 THEN PUT@A(CX,CY)-(CX+CCX,CY+CCY),PIC,,BX!,BY!
  579. 5790 IF C1=1 THEN PUT@A(CX,CY)-(CX+CCX,CY+CCY),PIC,MATTE,BX!,BY!,[CO(0,0),CO(0,1),CO(0,2)]
  580. 5800 IF C1=2 THEN PUT@A(CX,CY)-(CX+CCX,CY+CCY),PIC,PASTEL,BX!,BY!
  581. 5810 LINE(CX,CY)-(CX+CCX*BX!,CY+CCY*BY!),XOR,7,B:GOTO 5750
  582. 5820 *反転
  583. 5830 SCREEN 1,1:CX=MOUSE(0):CY=MOUSE(1):MOUSE 0,1:MOUSE 1,CX,CY,1:MOUSE 4,0,0,-511*(OP(8)=1)-319*(OP(8)=0),239:LINE(100,100)-(160,126),PSET,7,BF:SYMBOL(102,101),"上下反転",.75!,.75!,0:SYMBOL(102,113),"左右反転",.75!,.75!,0:MOUSE 4,100,100,160,125
  584. 5840 CY=INT((MOUSE(1)-100)/13):IF MOUSE(2,1)=-1 THEN 4700
  585. 5850 IF MOUSE(2,0)=0 THEN 5840
  586. 5860 MOUSE 1,,,0:LINE(0,0)-(319,239),PSET,[0,0,0,1],BF:SCREEN 1,0:IF CY=1 THEN 5880
  587. 5870 FOR A=CCY TO 0 STEP -1:PUT@A(CHX,CHY+CCY-A)-(CHX+CCX,CHY+CCY-A),PIC,,,,,(CCX+1)*A:NEXT:GOTO 4700
  588. 5880 CC=CCY+1:FOR A=CCX TO 0 STEP -1:GET@A(CHX+A,CHY)-(CHX+A,CHY+CCY),PIC,(CCY+1)*CCX-CC*A:NEXT:FOR A=0 TO CCX:PUT@A(CHX+A,CHY)-(CHX+A,CHY+CCY),PIC,,,,,CC*A:NEXT:GOTO 4700
  589. 5890 *入替え
  590. 5900 MOUSE 1,,,0
  591. 5910 FOR A=CHX TO CHX+CCX:FOR C=CHY TO CHY+CCY
  592. 5920 CC!=A*2+C*1024:C3=PEEK([&H1C]CC!):C2=PEEK([&H1C]CC!+1):B=(C3 AND 31)*8:G=((C2 AND 127)-(C2 AND 3))*2:R=INT(((C2 AND 3)*64+INT(C3/8)*2)/8)*8
  593. 5930 C1=G-CO(0,0):C2=R-CO(0,1):C3=B-CO(0,2):IF ABS(C1)<=OP(2) AND ABS(C2)<=OP(3) AND ABS(C3)<=OP(4) THEN 
  594. 5940 IF OP(5)=0 THEN Y1=CO(1,0):Y2=CO(1,1):Y3=CO(1,2) ELSE Y1=CO(1,0)+C1:Y2=CO(1,1)+C2:Y3=CO(1,2)+C3:Y1=-(Y1<256 AND Y1>0)*Y1-(Y1>255)*255:Y2=-(Y2<256 AND Y2>0)*Y2-(Y2>255)*255:Y3=-(Y3<256 AND Y3>0)*Y3-(Y3>255)*255
  595. 5950 PSET(A,C),[Y1,Y2,Y3]
  596. 5960 ENDIF
  597. 5970 NEXT:NEXT:GOTO 4700
  598. 5980 *回転
  599. 5990 SCREEN 1,1:LINE(100,80)-(200,120),PSET,7,BF:SYMBOL(101,81),"同色回転",.75!,.75!,0:SYMBOL(101,100),"完璧な回転",.75!,.75!,0:MOUSE 0,1:MOUSE 1,0,0,1:MOUSE 4,100,80,200,120
  600. 6000 CY=MOUSE(1):IF MOUSE(2,1)=-1 THEN 4700
  601. 6010 IF MOUSE(2,0)=0 THEN 6000
  602. 6020 IF CY<100 THEN CC=0 ELSE CC=1
  603. 6030 LINE(100,80)-(180,165),PSET,7,BF:SYMBOL(101,81),"角度",.75!,.75!,0:KA=0:SYMBOL(141,80),"↓↑",.75!,.75!,0:MOUSE 4,141,80,179,99:SIZ!=3.14159!/180:WAIT 20
  604. 6040 LINE(100,100)-(150,160),PSET,7,BF:LINE(130,140)-(130+COS(SIZ!*KA)*20,140+SIN(SIZ!*KA)*20),PSET,0:SYMBOL(100,100),STR$(KA),.75!,.75!,0
  605. 6050 CX=MOUSE(0):IF MOUSE(2,1)=-1 THEN 6110
  606. 6060 IF MOUSE(2,0)=0 THEN C=0:GOTO 6050
  607. 6070 IF C=0 THEN WAIT 9:C=1
  608. 6080 IF CX<153 THEN KA=KA-1:IF KA<0 THEN KA=359
  609. 6090 IF CX>152 THEN KA=KA+1:IF KA>359 THEN KA=0
  610. 6100 GOTO 6040
  611. 6110 KA=360-KA:LINE(0,0)-(319,239),PSET,[0,0,0,1],BF:MOUSE 1,,,0:CX1=CHX+INT(CCX/2):CY1=CHY+INT(CCY/2)
  612. 6120 SCREEN 1,1:KA2!=3.14159!/180*KA
  613. 6130 IF CC=0 THEN
  614. 6140 FOR A=CHY TO CHY+CCY:FOR C=CHX TO CHX+CCX
  615. 6150 CC!=SQR((A-CY1)^2+(C-CX1)^2)
  616. 6160 KA!=ATN((A-CY1)/(C-CX1+1E-32))+KA2!:BX!=((SGN(C-CX1)-(SGN(C-CX1)=0))*COS(KA!)*CC!+CX1+.5!):BY!=((SGN(C-CX1)-(SGN(C-CX1)=0))*SIN(KA!)*CC!+CY1+.5!)
  617. 6170 CC!=INT(BX!)*2+INT(BY!)*1024:C3=PEEK([&H1C]CC!):C2=PEEK([&H1C]CC!+1):B=(C3 AND 31)*8:G=((C2 AND 127)-(C2 AND 3))*2:R=INT(((C2 AND 3)*64+INT(C3/8)*2)/8)*8:PSET(C,A),[G,R,B]:NEXT:NEXT
  618. 6180 ELSE
  619. 6190 FOR A=CHY TO CHY+CCY:FOR C=CHX TO CHX+CCX
  620. 6200 CC!=SQR((A-CY1)^2+(C-CX1)^2)
  621. 6210 KA!=ATN((A-CY1)/(C-CX1+1E-32))+KA2!:BX!=((SGN(C-CX1)-(SGN(C-CX1)=0))*COS(KA!)*CC!+CX1+.5!):BY!=((SGN(C-CX1)-(SGN(C-CX1)=0))*SIN(KA!)*CC!+CY1+.5!)
  622. 6220 G=0:R=0:B=0:FOR GY=-1 TO 1:FOR GX=-1 TO 1:Y1!=ABS(GX-BX!+INT(BX!)):Y2!=ABS(GY-BY!+INT(BY!))
  623. 6230 IF Y1!<=1 AND Y2!<=1 THEN Y1!=((1-Y1!)+(1-Y2!))/2:CC!=INT(BX!+GX)*2+INT(BY!+GY)*1024:C3=PEEK([&H1C]CC!):C2=PEEK([&H1C]CC!+1):B=B+(C3 AND 31)*8*Y1!:G=G+(((C2 AND 127)-(C2 AND 3))*2)*Y1!:R=R+INT(((C2 AND 3)*64+INT(C3/8)*2)/8)*8*Y1!
  624. 6240 NEXT:NEXT
  625. 6250 G=-(G<256)*G-(G>255)*255:R=-(R<256)*R-(R>255)*255:B=-(B<256)*B-(B>255):PSET(C,A),[G,R,B]:NEXT:NEXT
  626. 6260 ENDIF
  627. 6270 GET@A(CHX,CHY)-(CHX+CCX,CHY+CCY),PIC:SCREEN 1,0:PUT@A(CHX,CHY)-(CHX+CCX,CHY+CCY),PIC:GOTO 4700
  628. 6280 *字
  629. 6290 MOUSE 1,,,0:SCREEN 0:OUT &H440,17:CONSOLE 0,23,2:OUT &H442,160:PRINT "出力する文字を入力してください｡":LINE INPUT C$:IF C$="" OR C$=CHR$(13) THEN 4700
  630. 6300 PRINT "フォント番号":FOR CC=1 TO 13
  631. 6310 ON CC GOSUB 6350,6360,6370,6380,6390,6400,6410,6420,6430,6440,6450,6460,6470
  632. 6320 PRINT STR$(CC)+")"+A$:NEXT
  633. 6330 INPUT CC:IF CC<0 OR CC>13 THEN 6300
  634. 6340 ON CC GOSUB 6350,6360,6370,6380,6390,6400,6410,6420,6430,6440,6450,6460,6470:GOTO 6480
  635. 6350 A$="システム   12ﾄﾞｯﾄ":RETURN
  636. 6360 A$="システム   16ﾄﾞｯﾄ":RETURN
  637. 6370 A$="明朝体     24ﾄﾞｯﾄ":RETURN
  638. 6380 A$="ゴシック体 24ﾄﾞｯﾄ":RETURN
  639. 6390 A$="教科書体   24ﾄﾞｯﾄ":RETURN
  640. 6400 A$="まるもじ   24ﾄﾞｯﾄ":RETURN
  641. 6410 A$="明朝体     32ﾄﾞｯﾄ":RETURN
  642. 6420 A$="ゴシック体 32ﾄﾞｯﾄ":RETURN
  643. 6430 A$="明朝体     48ﾄﾞｯﾄ":RETURN
  644. 6440 A$="ゴシック体 48ﾄﾞｯﾄ":RETURN
  645. 6450 A$="毛筆体     48ﾄﾞｯﾄ":RETURN
  646. 6460 A$="明朝体     60ﾄﾞｯﾄ":RETURN
  647. 6470 A$="ゴシック体 60ﾄﾞｯﾄ":RETURN
  648. 6480 OUT &H440,17:OUT &H442,0:C1=12:IF CC=2 THEN C1=16
  649. 6490 IF CC>2 AND CC<7 THEN C1=24
  650. 6500 IF CC=7 OR CC=8 THEN C1=32
  651. 6510 IF CC>8 AND CC<12 THEN C1=48
  652. 6520 IF CC>11 THEN C1=60
  653. 6530 SCREEN 1,1:SCREEN @1:GOSUB *コメ:SE$="字を出力する場所":MOUSE 0:MOUSE 4,0,0,-511*(OP(8)=1)-319*(OP(8)=0),239
  654. 6540 GOSUB *コメント:CX=INT(CX/SI)*SI:CY=INT(CY/SI)*SI:LINE(CX,CY)-(CX+LEN(C$)*C1/2,CY+C1),XOR,7,B:LINE(CX,CY)-(CX+LEN(C$)*C1/2,CY+C1),XOR,7,B
  655. 6550 IF MOUSE(2,0)=0 THEN 6540
  656. 6560 ON ERROR GOTO *ERMJ:DEF FONT A$:ON ERROR GOTO 0:SYMBOL(CX,CY),C$,C1/16,C1/16,[CO(0,0),CO(0,1),CO(0,2)]
  657. 6570 IF MJC=1 THEN DEF FONT S12$ ELSE DEF FONT S16$
  658. 6580 GOTO 4700
  659. 6590 *ERMJ
  660. 6600 BEEP:PRINT "このフォントは現在使用できません｡":RESUME 6300
  661. 6610 *明るさ
  662. 6620 SCREEN 1,1:CX=MOUSE(0):CY=MOUSE(1):MOUSE 0,1:MOUSE 1,CX,CY,1:MOUSE 4,0,0,-511*(OP(8)=1)-319*(OP(8)=0),239:LINE(100,100)-(300,150),PSET,7,BF:SYMBOL(101,101),"明るさ 1で 同じ それ以上で明るく",.75!,.75!,0
  663. 6630 BA!=1:SYMBOL(130,130),"↓",.75!,.75!,0:SYMBOL(200,130),"↑",.75!,.75!,0
  664. 6640 LINE(150,130)-(200,141),PSET,7,BF:SYMBOL(150,130),STR$(BA!),.75!,.75!,0
  665. 6650 CX=MOUSE(0)-130:CY=MOUSE(1)-130:IF MOUSE(2,1)=-1 THEN IF BA!=1 THEN 4700 ELSE 6710
  666. 6660 IF MOUSE(2,0)=0 THEN 6650
  667. 6670 IF CY<0 OR CY>19 OR CX<0 THEN 6650
  668. 6680 IF CX<20 THEN BA!=BA!-.1!:IF BA!<.1! THEN BA!=.1!
  669. 6690 IF CX>70 AND CX<90 THEN BA!=BA!+.11!
  670. 6700 BA!=INT(BA!*10)/10:GOTO 6640
  671. 6710 LINE(0,0)-(319,239),PSET,[0,0,0,1],BF
  672. 6720 SCREEN 1,0:FOR A=CHX TO CHX+CCX:FOR C=CHY TO CHY+CCY:CC!=A*2+C*1024:C3=PEEK([&H1C]CC!):C2=PEEK([&H1C]CC!+1):B=(C3 AND 31)*8:G=((C2 AND 127)-(C2 AND 3))*2:R=INT(((C2 AND 3)*64+(C3/8)*2)/8)*8
  673. 6730 Y1=G*BA!:Y2=R*BA!:Y3=B*BA!:Y1=-(Y1<256)*Y1-(Y1>255)*255+(Y1=0)*(BA!>1)*8:Y2=-(Y2<256)*Y2-(Y2>255)*255+(Y2=0)*(BA!>1)*8:Y3=-(Y3<256)*Y3-(Y3>255)*255+(Y3=0)*(BA!>1)
  674. 6740 PSET(A,C),[Y1,Y2,Y3]:NEXT:NEXT
  675. 6750 SCREEN 1,1:SE$="元の絵に戻しますか｡":GOSUB *YN:IF QC=0 THEN SCREEN 1,0:PUT@A(CHX,CHY)-(CHX+CCX,CHY+CCY),PIC
  676. 6760 GOTO 4700
  677. 6770 *霧
  678. 6780 CC=OP(6):C2=SQR(CC):GOSUB *コメ:SE$="霧吹きの中心指定"
  679. 6790 GOSUB *コメント:IF MOUSE(2,1)=-1 THEN PASTEL OP(1):GOTO 4700
  680. 6800 IF MOUSE(2,0)=0 THEN 6790
  681. 6810 MOUSE 1,,,0:FOR A=0 TO (CC+3)/3:CCX=INT(RND*CC-CC/2):CCY=INT(RND*CC-CC/2):C1=INT(255-C2*SQR(CCX^2*CCY^2)):C1=-(C1>8)*C1-(C1<9)*8:PASTEL C1:PSET(CX+CCX,CY+CCY),[CO(0,0),CO(0,1),CO(0,2)],PASTEL:NEXT
  682. 6820 MOUSE 1,,,1:GOTO 6790
  683. 6830 *混合
  684. 6840 LINE(CHX,CHY)-(CHX+CCX,CHY+CCY),PASTEL,[CO(C1,0),CO(C1,1),CO(C1,2)],BF:GOTO 4700
  685. 6850 *スプライト
  686. 6860 MOUSE 1,,,0:FOR A=CHX TO CHX+CCX:FOR C=CHY TO CHY+CCY:CC!=A*2+C*1024:C3=PEEK([&H1C]CC!):C2=PEEK([&H1C]CC!+1):IF C2=0 AND C3=0 THEN POKE [&H1C]CC!+1,128
  687. 6870 NEXT:NEXT:GOTO 4700
  688. 6880 *CLS
  689. 6890 LINE(0,0)-(319,239),PSET,0,BF:RETURN
  690. 6900 *復活
  691. 6910 IF PICBAK=1 THEN SE$="絵を元に戻していいですか｡":GOSUB *YN:IF QC=0 THEN SCREEN 1,0:PUT@A(0,0)-(511,239),PICBAK
  692. 6920 GOTO 4700
  693.